home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 May / Macworld (1998-05).dmg / Serious Demos / TeamWave 3.0 / TeamWave Workplace / TeamWave Workplace.rsrc / TEXT_13_text.txt < prev    next >
Text File  |  1998-02-13  |  26KB  |  1,011 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # SCCS: @(#) text.tcl 1.58 97/09/17 18:54:56
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # char -        Character position on the line;  kept in order
  22. #            to allow moving up or down past short lines while
  23. #            still remembering the desired position.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # prevPos -        Used when moving up or down lines via the keyboard.
  28. #            Keeps track of the previous insert position, so
  29. #            we can distinguish a series of ups and downs, all
  30. #            in a row, from a new up or down.
  31. # selectMode -        The style of selection currently underway:
  32. #            char, word, or line.
  33. # x, y -        Last known mouse coordinates for scanning
  34. #            and auto-scanning.
  35. #-------------------------------------------------------------------------
  36.  
  37. #-------------------------------------------------------------------------
  38. # The code below creates the default class bindings for entries.
  39. #-------------------------------------------------------------------------
  40.  
  41. # Standard Motif bindings:
  42.  
  43. bind Text <1> {
  44.     tkTextButton1 %W %x %y
  45.     %W tag remove sel 0.0 end
  46. }
  47. bind Text <B1-Motion> {
  48.     set tkPriv(x) %x
  49.     set tkPriv(y) %y
  50.     tkTextSelectTo %W %x %y
  51. }
  52. bind Text <Double-1> {
  53.     set tkPriv(selectMode) word
  54.     tkTextSelectTo %W %x %y
  55.     catch {%W mark set insert sel.first}
  56. }
  57. bind Text <Triple-1> {
  58.     set tkPriv(selectMode) line
  59.     tkTextSelectTo %W %x %y
  60.     catch {%W mark set insert sel.first}
  61. }
  62. bind Text <Shift-1> {
  63.     tkTextResetAnchor %W @%x,%y
  64.     set tkPriv(selectMode) char
  65.     tkTextSelectTo %W %x %y
  66. }
  67. bind Text <Double-Shift-1>    {
  68.     set tkPriv(selectMode) word
  69.     tkTextSelectTo %W %x %y
  70. }
  71. bind Text <Triple-Shift-1>    {
  72.     set tkPriv(selectMode) line
  73.     tkTextSelectTo %W %x %y
  74. }
  75. bind Text <B1-Leave> {
  76.     set tkPriv(x) %x
  77.     set tkPriv(y) %y
  78.     tkTextAutoScan %W
  79. }
  80. bind Text <B1-Enter> {
  81.     tkCancelRepeat
  82. }
  83. bind Text <ButtonRelease-1> {
  84.     tkCancelRepeat
  85. }
  86. bind Text <Control-1> {
  87.     %W mark set insert @%x,%y
  88. }
  89. bind Text <ButtonRelease-2> {
  90.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  91.     tkTextPaste %W %x %y
  92.     }
  93. }
  94. bind Text <Left> {
  95.     tkTextSetCursor %W insert-1c
  96. }
  97. bind Text <Right> {
  98.     tkTextSetCursor %W insert+1c
  99. }
  100. bind Text <Up> {
  101.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  102. }
  103. bind Text <Down> {
  104.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  105. }
  106. bind Text <Shift-Left> {
  107.     tkTextKeySelect %W [%W index {insert - 1c}]
  108. }
  109. bind Text <Shift-Right> {
  110.     tkTextKeySelect %W [%W index {insert + 1c}]
  111. }
  112. bind Text <Shift-Up> {
  113.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  114. }
  115. bind Text <Shift-Down> {
  116.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  117. }
  118. bind Text <Control-Left> {
  119.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  120. }
  121. bind Text <Control-Right> {
  122.     tkTextSetCursor %W [tkTextNextWord %W insert]
  123. }
  124. bind Text <Control-Up> {
  125.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  126. }
  127. bind Text <Control-Down> {
  128.     tkTextSetCursor %W [tkTextNextPara %W insert]
  129. }
  130. bind Text <Shift-Control-Left> {
  131.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  132. }
  133. bind Text <Shift-Control-Right> {
  134.     tkTextKeySelect %W [tkTextNextWord %W insert]
  135. }
  136. bind Text <Shift-Control-Up> {
  137.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  138. }
  139. bind Text <Shift-Control-Down> {
  140.     tkTextKeySelect %W [tkTextNextPara %W insert]
  141. }
  142. bind Text <Prior> {
  143.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  144. }
  145. bind Text <Shift-Prior> {
  146.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  147. }
  148. bind Text <Next> {
  149.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  150. }
  151. bind Text <Shift-Next> {
  152.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  153. }
  154. bind Text <Control-Prior> {
  155.     %W xview scroll -1 page
  156. }
  157. bind Text <Control-Next> {
  158.     %W xview scroll 1 page
  159. }
  160.  
  161. bind Text <Home> {
  162.     tkTextSetCursor %W {insert linestart}
  163. }
  164. bind Text <Shift-Home> {
  165.     tkTextKeySelect %W {insert linestart}
  166. }
  167. bind Text <End> {
  168.     tkTextSetCursor %W {insert lineend}
  169. }
  170. bind Text <Shift-End> {
  171.     tkTextKeySelect %W {insert lineend}
  172. }
  173. bind Text <Control-Home> {
  174.     tkTextSetCursor %W 1.0
  175. }
  176. bind Text <Control-Shift-Home> {
  177.     tkTextKeySelect %W 1.0
  178. }
  179. bind Text <Control-End> {
  180.     tkTextSetCursor %W {end - 1 char}
  181. }
  182. bind Text <Control-Shift-End> {
  183.     tkTextKeySelect %W {end - 1 char}
  184. }
  185.  
  186. bind Text <Tab> {
  187.     tkTextInsert %W \t
  188.     focus %W
  189.     break
  190. }
  191. bind Text <Shift-Tab> {
  192.     # Needed only to keep <Tab> binding from triggering;  doesn't
  193.     # have to actually do anything.
  194.     break
  195. }
  196. bind Text <Control-Tab> {
  197.     focus [tk_focusNext %W]
  198. }
  199. bind Text <Control-Shift-Tab> {
  200.     focus [tk_focusPrev %W]
  201. }
  202. bind Text <Control-i> {
  203.     tkTextInsert %W \t
  204. }
  205. bind Text <Return> {
  206.     tkTextInsert %W \n
  207. }
  208. bind Text <Delete> {
  209.     if {[%W tag nextrange sel 1.0 end] != ""} {
  210.     %W delete sel.first sel.last
  211.     } else {
  212.     %W delete insert
  213.     %W see insert
  214.     }
  215. }
  216. bind Text <BackSpace> {
  217.     if {[%W tag nextrange sel 1.0 end] != ""} {
  218.     %W delete sel.first sel.last
  219.     } elseif [%W compare insert != 1.0] {
  220.     %W delete insert-1c
  221.     %W see insert
  222.     }
  223. }
  224.  
  225. bind Text <Control-space> {
  226.     %W mark set anchor insert
  227. }
  228. bind Text <Select> {
  229.     %W mark set anchor insert
  230. }
  231. bind Text <Control-Shift-space> {
  232.     set tkPriv(selectMode) char
  233.     tkTextKeyExtend %W insert
  234. }
  235. bind Text <Shift-Select> {
  236.     set tkPriv(selectMode) char
  237.     tkTextKeyExtend %W insert
  238. }
  239. bind Text <Control-slash> {
  240.     %W tag add sel 1.0 end
  241. }
  242. bind Text <Control-backslash> {
  243.     %W tag remove sel 1.0 end
  244. }
  245. bind Text <<Cut>> {
  246.     tk_textCut %W
  247. }
  248. bind Text <<Copy>> {
  249.     tk_textCopy %W
  250. }
  251. bind Text <<Paste>> {
  252.     tk_textPaste %W
  253. }
  254. bind Text <<Clear>> {
  255.     catch {%W delete sel.first sel.last}
  256. }
  257. bind Text <Insert> {
  258.     catch {tkTextInsert %W [selection get -displayof %W]}
  259. }
  260. bind Text <KeyPress> {
  261.     tkTextInsert %W %A
  262. }
  263.  
  264. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  265. # Otherwise, if a widget binding for one of these is defined, the
  266. # <KeyPress> class binding will also fire and insert the character,
  267. # which is wrong.  Ditto for <Escape>.
  268.  
  269. bind Text <Alt-KeyPress> {# nothing }
  270. bind Text <Meta-KeyPress> {# nothing}
  271. bind Text <Control-KeyPress> {# nothing}
  272. bind Text <Escape> {# nothing}
  273. bind Text <KP_Enter> {# nothing}
  274. if {$tcl_platform(platform) == "macintosh"} {
  275.     bind Text <Command-KeyPress> {# nothing}
  276. }
  277.  
  278. # Additional emacs-like bindings:
  279.  
  280. bind Text <Control-a> {
  281.     if !$tk_strictMotif {
  282.     tkTextSetCursor %W {insert linestart}
  283.     }
  284. }
  285. bind Text <Control-b> {
  286.     if !$tk_strictMotif {
  287.     tkTextSetCursor %W insert-1c
  288.     }
  289. }
  290. bind Text <Control-d> {
  291.     if !$tk_strictMotif {
  292.     %W delete insert
  293.     }
  294. }
  295. bind Text <Control-e> {
  296.     if !$tk_strictMotif {
  297.     tkTextSetCursor %W {insert lineend}
  298.     }
  299. }
  300. bind Text <Control-f> {
  301.     if !$tk_strictMotif {
  302.     tkTextSetCursor %W insert+1c
  303.     }
  304. }
  305. bind Text <Control-k> {
  306.     if !$tk_strictMotif {
  307.     if [%W compare insert == {insert lineend}] {
  308.         %W delete insert
  309.     } else {
  310.         %W delete insert {insert lineend}
  311.     }
  312.     }
  313. }
  314. bind Text <Control-n> {
  315.     if !$tk_strictMotif {
  316.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  317.     }
  318. }
  319. bind Text <Control-o> {
  320.     if !$tk_strictMotif {
  321.     %W insert insert \n
  322.     %W mark set insert insert-1c
  323.     }
  324. }
  325. bind Text <Control-p> {
  326.     if !$tk_strictMotif {
  327.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  328.     }
  329. }
  330. bind Text <Control-t> {
  331.     if !$tk_strictMotif {
  332.     tkTextTranspose %W
  333.     }
  334. }
  335.  
  336. if {$tcl_platform(platform) != "windows"} {
  337. bind Text <Control-v> {
  338.     if !$tk_strictMotif {
  339.     tkTextScrollPages %W 1
  340.     }
  341. }
  342. }
  343.  
  344. bind Text <Meta-b> {
  345.     if !$tk_strictMotif {
  346.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  347.     }
  348. }
  349. bind Text <Meta-d> {
  350.     if !$tk_strictMotif {
  351.     %W delete insert [tkTextNextWord %W insert]
  352.     }
  353. }
  354. bind Text <Meta-f> {
  355.     if !$tk_strictMotif {
  356.     tkTextSetCursor %W [tkTextNextWord %W insert]
  357.     }
  358. }
  359. bind Text <Meta-less> {
  360.     if !$tk_strictMotif {
  361.     tkTextSetCursor %W 1.0
  362.     }
  363. }
  364. bind Text <Meta-greater> {
  365.     if !$tk_strictMotif {
  366.     tkTextSetCursor %W end-1c
  367.     }
  368. }
  369. bind Text <Meta-BackSpace> {
  370.     if !$tk_strictMotif {
  371.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  372.     }
  373. }
  374. bind Text <Meta-Delete> {
  375.     if !$tk_strictMotif {
  376.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  377.     }
  378. }
  379.  
  380. # Macintosh only bindings:
  381.  
  382. # if text black & highlight black -> text white, other text the same
  383. if {$tcl_platform(platform) == "macintosh"} {
  384. bind Text <FocusIn> {
  385.     %W tag configure sel -borderwidth 0
  386.     %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
  387. }
  388. bind Text <FocusOut> {
  389.     %W tag configure sel -borderwidth 1
  390.     %W configure -selectbackground white -selectforeground black
  391. }
  392. bind Text <Option-Left> {
  393.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  394. }
  395. bind Text <Option-Right> {
  396.     tkTextSetCursor %W [tkTextNextWord %W insert]
  397. }
  398. bind Text <Option-Up> {
  399.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  400. }
  401. bind Text <Option-Down> {
  402.     tkTextSetCursor %W [tkTextNextPara %W insert]
  403. }
  404. bind Text <Shift-Option-Left> {
  405.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  406. }
  407. bind Text <Shift-Option-Right> {
  408.     tkTextKeySelect %W [tkTextNextWord %W insert]
  409. }
  410. bind Text <Shift-Option-Up> {
  411.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  412. }
  413. bind Text <Shift-Option-Down> {
  414.     tkTextKeySelect %W [tkTextNextPara %W insert]
  415. }
  416.  
  417. # End of Mac only bindings
  418. }
  419.  
  420. # A few additional bindings of my own.
  421.  
  422. bind Text <Control-h> {
  423.     if !$tk_strictMotif {
  424.     if [%W compare insert != 1.0] {
  425.         %W delete insert-1c
  426.         %W see insert
  427.     }
  428.     }
  429. }
  430. bind Text <2> {
  431.     if !$tk_strictMotif {
  432.     %W scan mark %x %y
  433.     set tkPriv(x) %x
  434.     set tkPriv(y) %y
  435.     set tkPriv(mouseMoved) 0
  436.     }
  437. }
  438. bind Text <B2-Motion> {
  439.     if !$tk_strictMotif {
  440.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  441.         set tkPriv(mouseMoved) 1
  442.     }
  443.     if $tkPriv(mouseMoved) {
  444.         %W scan dragto %x %y
  445.     }
  446.     }
  447. }
  448. set tkPriv(prevPos) {}
  449.  
  450. # tkTextClosestGap --
  451. # Given x and y coordinates, this procedure finds the closest boundary
  452. # between characters to the given coordinates and returns the index
  453. # of the character just after the boundary.
  454. #
  455. # Arguments:
  456. # w -        The text window.
  457. # x -        X-coordinate within the window.
  458. # y -        Y-coordinate within the window.
  459.  
  460. proc tkTextClosestGap {w x y} {
  461.     set pos [$w index @$x,$y]
  462.     set bbox [$w bbox $pos]
  463.     if ![string compare $bbox ""] {
  464.     return $pos
  465.     }
  466.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  467.     return $pos
  468.     }
  469.     $w index "$pos + 1 char"
  470. }
  471.  
  472. # tkTextButton1 --
  473. # This procedure is invoked to handle button-1 presses in text
  474. # widgets.  It moves the insertion cursor, sets the selection anchor,
  475. # and claims the input focus.
  476. #
  477. # Arguments:
  478. # w -        The text window in which the button was pressed.
  479. # x -        The x-coordinate of the button press.
  480. # y -        The x-coordinate of the button press.
  481.  
  482. proc tkTextButton1 {w x y} {
  483.     global tkPriv
  484.  
  485.     set tkPriv(selectMode) char
  486.     set tkPriv(mouseMoved) 0
  487.     set tkPriv(pressX) $x
  488.     $w mark set insert [tkTextClosestGap $w $x $y]
  489.     $w mark set anchor insert
  490.     if {[$w cget -state] == "normal"} {focus $w}
  491. }
  492.  
  493. # tkTextSelectTo --
  494. # This procedure is invoked to extend the selection, typically when
  495. # dragging it with the mouse.  Depending on the selection mode (character,
  496. # word, line) it selects in different-sized units.  This procedure
  497. # ignores mouse motions initially until the mouse has moved from
  498. # one character to another or until there have been multiple clicks.
  499. #
  500. # Arguments:
  501. # w -        The text window in which the button was pressed.
  502. # x -        Mouse x position.
  503. # y -         Mouse y position.
  504.  
  505. proc tkTextSelectTo {w x y} {
  506.     global tkPriv tcl_platform
  507.  
  508.     set cur [tkTextClosestGap $w $x $y]
  509.     if [catch {$w index anchor}] {
  510.     $w mark set anchor $cur
  511.     }
  512.     set anchor [$w index anchor]
  513.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  514.     set tkPriv(mouseMoved) 1
  515.     }
  516.     switch $tkPriv(selectMode) {
  517.     char {
  518.         if [$w compare $cur < anchor] {
  519.         set first $cur
  520.         set last anchor
  521.         } else {
  522.         set first anchor
  523.         set last $cur
  524.         }
  525.     }
  526.     word {
  527.         if [$w compare $cur < anchor] {
  528.         set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
  529.         set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
  530.         } else {
  531.         set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
  532.         set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
  533.         }
  534.     }
  535.     line {
  536.         if [$w compare $cur < anchor] {
  537.         set first [$w index "$cur linestart"]
  538.         set last [$w index "anchor - 1c lineend + 1c"]
  539.         } else {
  540.         set first [$w index "anchor linestart"]
  541.         set last [$w index "$cur lineend + 1c"]
  542.         }
  543.     }
  544.     }
  545.     if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
  546.     if {$tcl_platform(platform) != "unix" && [$w compare $cur < anchor]} {
  547.         $w mark set insert $first
  548.     } else {
  549.         $w mark set insert $last
  550.     }
  551.     $w tag remove sel 0.0 $first
  552.     $w tag add sel $first $last
  553.     $w tag remove sel $last end
  554.     update idletasks
  555.     }
  556. }
  557.  
  558. # tkTextKeyExtend --
  559. # This procedure handles extending the selection from the keyboard,
  560. # where the point to extend to is really the boundary between two
  561. # characters rather than a particular character.
  562. #
  563. # Arguments:
  564. # w -        The text window.
  565. # index -    The point to which the selection is to be extended.
  566.  
  567. proc tkTextKeyExtend {w index} {
  568.     global tkPriv
  569.  
  570.     set cur [$w index $index]
  571.     if [catch {$w index anchor}] {
  572.     $w mark set anchor $cur
  573.     }
  574.     set anchor [$w index anchor]
  575.     if [$w compare $cur < anchor] {
  576.     set first $cur
  577.     set last anchor
  578.     } else {
  579.     set first anchor
  580.     set last $cur
  581.     }
  582.     $w tag remove sel 0.0 $first
  583.     $w tag add sel $first $last
  584.     $w tag remove sel $last end
  585. }
  586.  
  587. # tkTextPaste --
  588. # This procedure sets the insertion cursor to the mouse position,
  589. # inserts the selection, and sets the focus to the window.
  590. #
  591. # Arguments:
  592. # w -        The text window.
  593. # x, y -     Position of the mouse.
  594.  
  595. proc tkTextPaste {w x y} {
  596.     $w mark set insert [tkTextClosestGap $w $x $y]
  597.     catch {$w insert insert [selection get -displayof $w]}
  598.     if {[$w cget -state] == "normal"} {focus $w}
  599. }
  600.  
  601. # tkTextAutoScan --
  602. # This procedure is invoked when the mouse leaves a text window
  603. # with button 1 down.  It scrolls the window up, down, left, or right,
  604. # depending on where the mouse is (this information was saved in
  605. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  606. # command so that the window continues to scroll until the mouse
  607. # moves back into the window or the mouse button is released.
  608. #
  609. # Arguments:
  610. # w -        The text window.
  611.  
  612. proc tkTextAutoScan {w} {
  613.     global tkPriv
  614.     if {![winfo exists $w]} return
  615.     if {$tkPriv(y) >= [winfo height $w]} {
  616.     $w yview scroll 2 units
  617.     } elseif {$tkPriv(y) < 0} {
  618.     $w yview scroll -2 units
  619.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  620.     $w xview scroll 2 units
  621.     } elseif {$tkPriv(x) < 0} {
  622.     $w xview scroll -2 units
  623.     } else {
  624.     return
  625.     }
  626.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  627.     set tkPriv(afterId) [after 50 tkTextAutoScan $w]
  628. }
  629.  
  630. # tkTextSetCursor
  631. # Move the insertion cursor to a given position in a text.  Also
  632. # clears the selection, if there is one in the text, and makes sure
  633. # that the insertion cursor is visible.  Also, don't let the insertion
  634. # cursor appear on the dummy last line of the text.
  635. #
  636. # Arguments:
  637. # w -        The text window.
  638. # pos -        The desired new position for the cursor in the window.
  639.  
  640. proc tkTextSetCursor {w pos} {
  641.     global tkPriv
  642.  
  643.     if [$w compare $pos == end] {
  644.     set pos {end - 1 chars}
  645.     }
  646.     $w mark set insert $pos
  647.     $w tag remove sel 1.0 end
  648.     $w see insert
  649. }
  650.  
  651. # tkTextKeySelect
  652. # This procedure is invoked when stroking out selections using the
  653. # keyboard.  It moves the cursor to a new position, then extends
  654. # the selection to that position.
  655. #
  656. # Arguments:
  657. # w -        The text window.
  658. # new -        A new position for the insertion cursor (the cursor hasn't
  659. #        actually been moved to this position yet).
  660.  
  661. proc tkTextKeySelect {w new} {
  662.     global tkPriv
  663.  
  664.     if {[$w tag nextrange sel 1.0 end] == ""} {
  665.     if [$w compare $new < insert] {
  666.         $w tag add sel $new insert
  667.     } else {
  668.         $w tag add sel insert $new
  669.     }
  670.     $w mark set anchor insert
  671.     } else {
  672.     if [$w compare $new < anchor] {
  673.         set first $new
  674.         set last anchor
  675.     } else {
  676.         set first anchor
  677.         set last $new
  678.     }
  679.     $w tag remove sel 1.0 $first
  680.     $w tag add sel $first $last
  681.     $w tag remove sel $last end
  682.     }
  683.     $w mark set insert $new
  684.     $w see insert
  685.     update idletasks
  686. }
  687.  
  688. # tkTextResetAnchor --
  689. # Set the selection anchor to whichever end is farthest from the
  690. # index argument.  One special trick: if the selection has two or
  691. # fewer characters, just leave the anchor where it is.  In this
  692. # case it doesn't matter which point gets chosen for the anchor,
  693. # and for the things like Shift-Left and Shift-Right this produces
  694. # better behavior when the cursor moves back and forth across the
  695. # anchor.
  696. #
  697. # Arguments:
  698. # w -        The text widget.
  699. # index -    Position at which mouse button was pressed, which determines
  700. #        which end of selection should be used as anchor point.
  701.  
  702. proc tkTextResetAnchor {w index} {
  703.     global tkPriv
  704.  
  705.     if {[$w tag ranges sel] == ""} {
  706.     $w mark set anchor $index
  707.     return
  708.     }
  709.     set a [$w index $index]
  710.     set b [$w index sel.first]
  711.     set c [$w index sel.last]
  712.     if [$w compare $a < $b] {
  713.     $w mark set anchor sel.last
  714.     return
  715.     }
  716.     if [$w compare $a > $c] {
  717.     $w mark set anchor sel.first
  718.     return
  719.     }
  720.     scan $a "%d.%d" lineA chA
  721.     scan $b "%d.%d" lineB chB
  722.     scan $c "%d.%d" lineC chC
  723.     if {$lineB < $lineC+2} {
  724.     set total [string length [$w get $b $c]]
  725.     if {$total <= 2} {
  726.         return
  727.     }
  728.     if {[string length [$w get $b $a]] < ($total/2)} {
  729.         $w mark set anchor sel.last
  730.     } else {
  731.         $w mark set anchor sel.first
  732.     }
  733.     return
  734.     }
  735.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  736.     $w mark set anchor sel.last
  737.     } else {
  738.     $w mark set anchor sel.first
  739.     }
  740. }
  741.  
  742. # tkTextInsert --
  743. # Insert a string into a text at the point of the insertion cursor.
  744. # If there is a selection in the text, and it covers the point of the
  745. # insertion cursor, then delete the selection before inserting.
  746. #
  747. # Arguments:
  748. # w -        The text window in which to insert the string
  749. # s -        The string to insert (usually just a single character)
  750.  
  751. proc tkTextInsert {w s} {
  752.     if {($s == "") || ([$w cget -state] == "disabled")} {
  753.     return
  754.     }
  755.     catch {
  756.     if {[$w compare sel.first <= insert]
  757.         && [$w compare sel.last >= insert]} {
  758.         $w delete sel.first sel.last
  759.     }
  760.     }
  761.     $w insert insert $s
  762.     $w see insert
  763. }
  764.  
  765. # tkTextUpDownLine --
  766. # Returns the index of the character one line above or below the
  767. # insertion cursor.  There are two tricky things here.  First,
  768. # we want to maintain the original column across repeated operations,
  769. # even though some lines that will get passed through don't have
  770. # enough characters to cover the original column.  Second, don't
  771. # try to scroll past the beginning or end of the text.
  772. #
  773. # Arguments:
  774. # w -        The text window in which the cursor is to move.
  775. # n -        The number of lines to move: -1 for up one line,
  776. #        +1 for down one line.
  777.  
  778. proc tkTextUpDownLine {w n} {
  779.     global tkPriv
  780.  
  781.     set i [$w index insert]
  782.     scan $i "%d.%d" line char
  783.     if {[string compare $tkPriv(prevPos) $i] != 0} {
  784.     set tkPriv(char) $char
  785.     }
  786.     set new [$w index [expr $line + $n].$tkPriv(char)]
  787.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  788.     set new $i
  789.     }
  790.     set tkPriv(prevPos) $new
  791.     return $new
  792. }
  793.  
  794. # tkTextPrevPara --
  795. # Returns the index of the beginning of the paragraph just before a given
  796. # position in the text (the beginning of a paragraph is the first non-blank
  797. # character after a blank line).
  798. #
  799. # Arguments:
  800. # w -        The text window in which the cursor is to move.
  801. # pos -        Position at which to start search.
  802.  
  803. proc tkTextPrevPara {w pos} {
  804.     set pos [$w index "$pos linestart"]
  805.     while 1 {
  806.     if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
  807.         || ($pos == "1.0")} {
  808.         if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  809.             dummy index] {
  810.         set pos [$w index "$pos + [lindex $index 0] chars"]
  811.         }
  812.         if {[$w compare $pos != insert] || ($pos == "1.0")} {
  813.         return $pos
  814.         }
  815.     }
  816.     set pos [$w index "$pos - 1 line"]
  817.     }
  818. }
  819.  
  820. # tkTextNextPara --
  821. # Returns the index of the beginning of the paragraph just after a given
  822. # position in the text (the beginning of a paragraph is the first non-blank
  823. # character after a blank line).
  824. #
  825. # Arguments:
  826. # w -        The text window in which the cursor is to move.
  827. # start -    Position at which to start search.
  828.  
  829. proc tkTextNextPara {w start} {
  830.     set pos [$w index "$start linestart + 1 line"]
  831.     while {[$w get $pos] != "\n"} {
  832.     if [$w compare $pos == end] {
  833.         return [$w index "end - 1c"]
  834.     }
  835.     set pos [$w index "$pos + 1 line"]
  836.     }
  837.     while {[$w get $pos] == "\n"} {
  838.     set pos [$w index "$pos + 1 line"]
  839.     if [$w compare $pos == end] {
  840.         return [$w index "end - 1c"]
  841.     }
  842.     }
  843.     if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  844.         dummy index] {
  845.     return [$w index "$pos + [lindex $index 0] chars"]
  846.     }
  847.     return $pos
  848. }
  849.  
  850. # tkTextScrollPages --
  851. # This is a utility procedure used in bindings for moving up and down
  852. # pages and possibly extending the selection along the way.  It scrolls
  853. # the view in the widget by the number of pages, and it returns the
  854. # index of the character that is at the same position in the new view
  855. # as the insertion cursor used to be in the old view.
  856. #
  857. # Arguments:
  858. # w -        The text window in which the cursor is to move.
  859. # count -    Number of pages forward to scroll;  may be negative
  860. #        to scroll backwards.
  861.  
  862. proc tkTextScrollPages {w count} {
  863.     set bbox [$w bbox insert]
  864.     $w yview scroll $count pages
  865.     if {$bbox == ""} {
  866.     return [$w index @[expr [winfo height $w]/2],0]
  867.     }
  868.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  869. }
  870.  
  871. # tkTextTranspose --
  872. # This procedure implements the "transpose" function for text widgets.
  873. # It tranposes the characters on either side of the insertion cursor,
  874. # unless the cursor is at the end of the line.  In this case it
  875. # transposes the two characters to the left of the cursor.  In either
  876. # case, the cursor ends up to the right of the transposed characters.
  877. #
  878. # Arguments:
  879. # w -        Text window in which to transpose.
  880.  
  881. proc tkTextTranspose w {
  882.     set pos insert
  883.     if [$w compare $pos != "$pos lineend"] {
  884.     set pos [$w index "$pos + 1 char"]
  885.     }
  886.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  887.     if [$w compare "$pos - 1 char" == 1.0] {
  888.     return
  889.     }
  890.     $w delete "$pos - 2 char" $pos
  891.     $w insert insert $new
  892.     $w see insert
  893. }
  894.  
  895. # tk_textCopy --
  896. # This procedure copies the selection from a text widget into the
  897. # clipboard.
  898. #
  899. # Arguments:
  900. # w -        Name of a text widget.
  901.  
  902. proc tk_textCopy w {
  903.     if {![catch {set data [$w get sel.first sel.last]}]} {
  904.     clipboard clear -displayof $w
  905.     clipboard append -displayof $w $data
  906.     }
  907. }
  908.  
  909. # tk_textCut --
  910. # This procedure copies the selection from a text widget into the
  911. # clipboard, then deletes the selection (if it exists in the given
  912. # widget).
  913. #
  914. # Arguments:
  915. # w -        Name of a text widget.
  916.  
  917. proc tk_textCut w {
  918.     if {![catch {set data [$w get sel.first sel.last]}]} {
  919.     clipboard clear -displayof $w
  920.     clipboard append -displayof $w $data
  921.     $w delete sel.first sel.last
  922.     }
  923. }
  924.  
  925. # tk_textPaste --
  926. # This procedure pastes the contents of the clipboard to the insertion
  927. # point in a text widget.
  928. #
  929. # Arguments:
  930. # w -        Name of a text widget.
  931.  
  932. proc tk_textPaste w {
  933.     global tcl_platform
  934.     catch {
  935.     if {"$tcl_platform(platform)" != "unix"} {
  936.         catch {
  937.         $w delete sel.first sel.last
  938.         }
  939.     }
  940.     $w insert insert [selection get -displayof $w -selection CLIPBOARD]
  941.     }
  942. }
  943.  
  944. # tkTextNextWord --
  945. # Returns the index of the next word position after a given position in the
  946. # text.  The next word is platform dependent and may be either the next
  947. # end-of-word position or the next start-of-word position after the next
  948. # end-of-word position.
  949. #
  950. # Arguments:
  951. # w -        The text window in which the cursor is to move.
  952. # start -    Position at which to start search.
  953.  
  954. if {$tcl_platform(platform) == "windows"}  {
  955.     proc tkTextNextWord {w start} {
  956.     tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
  957.         tcl_startOfNextWord
  958.     }
  959. } else {
  960.     proc tkTextNextWord {w start} {
  961.     tkTextNextPos $w $start tcl_endOfWord
  962.     }
  963. }
  964.  
  965. # tkTextNextPos --
  966. # Returns the index of the next position after the given starting
  967. # position in the text as computed by a specified function.
  968. #
  969. # Arguments:
  970. # w -        The text window in which the cursor is to move.
  971. # start -    Position at which to start search.
  972. # op -        Function to use to find next position.
  973.  
  974. proc tkTextNextPos {w start op} {
  975.     set text ""
  976.     set cur $start
  977.     while {[$w compare $cur < end]} {
  978.     set text "$text[$w get $cur "$cur lineend + 1c"]"
  979.     set pos [$op $text 0]
  980.     if {$pos >= 0} {
  981.         return [$w index "$start + $pos c"]
  982.     }
  983.     set cur [$w index "$cur lineend +1c"]
  984.     }
  985.     return end
  986. }
  987.  
  988. # tkTextPrevPos --
  989. # Returns the index of the previous position before the given starting
  990. # position in the text as computed by a specified function.
  991. #
  992. # Arguments:
  993. # w -        The text window in which the cursor is to move.
  994. # start -    Position at which to start search.
  995. # op -        Function to use to find next position.
  996.  
  997. proc tkTextPrevPos {w start op} {
  998.     set text ""
  999.     set cur $start
  1000.     while {[$w compare $cur > 0.0]} {
  1001.     set text "[$w get "$cur linestart - 1c" $cur]$text"
  1002.     set pos [$op $text end]
  1003.     if {$pos >= 0} {
  1004.         return [$w index "$cur linestart - 1c + $pos c"]
  1005.     }
  1006.     set cur [$w index "$cur linestart - 1c"]
  1007.     }
  1008.     return 0.0
  1009. }
  1010.  
  1011.